home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / f2c / may_5_92.lha / f2c.VMay_5_1992 / libI77 / rdfmt.c < prev    next >
C/C++ Source or Header  |  1992-05-07  |  6KB  |  325 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #include "fp.h"
  5.  
  6. extern int cursor;
  7. rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
  8. {    int ch;
  9.     for(;cursor>0;cursor--) if((ch=(*getn)())<0) return(ch);
  10.     if(cursor<0)
  11.     {    if(recpos+cursor < 0) /*err(elist->cierr,110,"fmt")*/
  12.             cursor = -recpos;    /* is this in the standard? */
  13.         if(external == 0) {
  14.             extern char *icptr;
  15.             icptr += cursor;
  16.         }
  17.         else if(curunit && curunit->useek)
  18.             (void) fseek(cf,(long) cursor,SEEK_CUR);
  19.         else
  20.             err(elist->cierr,106,"fmt");
  21.         recpos += cursor;
  22.         cursor=0;
  23.     }
  24.     switch(p->op)
  25.     {
  26.     default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
  27.         sig_die(fmtbuf, 1);
  28.     case I: ch = (rd_I((Uint *)ptr,p->p1,len, 10));
  29.         break;
  30.     case IM: ch = (rd_I((Uint *)ptr,p->p1,len, 10));
  31.         break;
  32.     case O: ch = (rd_I((Uint *)ptr, p->p1, len, 8));
  33.         break;
  34.     case L: ch = (rd_L((ftnint *)ptr,p->p1));
  35.         break;
  36.     case A:    ch = (rd_A(ptr,len));
  37.         break;
  38.     case AW:
  39.         ch = (rd_AW(ptr,p->p1,len));
  40.         break;
  41.     case E: case EE:
  42.     case D:
  43.     case G:
  44.     case GE:
  45.     case F:    ch = (rd_F((ufloat *)ptr,p->p1,p->p2,len));
  46.         break;
  47.     }
  48.     if(ch == 0) return(ch);
  49.     else if(ch == EOF) return(EOF);
  50.     clearerr(cf);
  51.     return(errno);
  52. }
  53. rd_ned(p) struct syl *p;
  54. {
  55.     switch(p->op)
  56.     {
  57.     default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op);
  58.         sig_die(fmtbuf, 1);
  59.     case APOS:
  60.         return(rd_POS(*(char **)&p->p2));
  61.     case H:    return(rd_H(p->p1,*(char **)&p->p2));
  62.     case SLASH: return((*donewrec)());
  63.     case TR:
  64.     case X:    cursor += p->p1;
  65.         return(1);
  66.     case T: cursor=p->p1-recpos - 1;
  67.         return(1);
  68.     case TL: cursor -= p->p1;
  69.         if(cursor < -recpos)    /* TL1000, 1X */
  70.             cursor = -recpos;
  71.         return(1);
  72.     }
  73. }
  74. rd_I(n,w,len, base) ftnlen len; Uint *n; register int base;
  75. {    long x;
  76.     int sign,ch;
  77.     char s[84], *ps;
  78.     ps=s; x=0;
  79.     while (w)
  80.     {
  81.         GET(ch);
  82.         if (ch==',' || ch=='\n') break;
  83.         *ps=ch; ps++; w--;
  84.     }
  85.     *ps='\0';
  86.     ps=s;
  87.     while (*ps==' ') ps++;
  88.     if (*ps=='-') { sign=1; ps++; }
  89.     else { sign=0; if (*ps=='+') ps++; }
  90. loop:    while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; }
  91.     if (*ps==' ') {if (cblank) x *= base; ps++; goto loop;}
  92.     if(sign) x = -x;
  93.     if(len==sizeof(integer)) n->il=x;
  94.     else if(len == sizeof(char)) n->ic = x;
  95.     else n->is=x;
  96.     if (*ps) return(errno=115); else return(0);
  97. }
  98. rd_L(n,w) ftnint *n;
  99. {    int ch;
  100.     char s[84], *ps;
  101.     ps=s;
  102.     while (w) {
  103.         GET(ch);
  104.         if (ch==','||ch=='\n') break;
  105.         *ps=ch;
  106.         ps++; w--;
  107.         }
  108.     *ps='\0';
  109.     ps=s; while (*ps==' ') ps++;
  110.     if (*ps=='.') ps++;
  111.     if (*ps=='t' || *ps == 'T') { *n=1; return(0); }
  112.     else if (*ps == 'f' || *ps == 'F') { *n=0; return(0); }
  113.     else return(errno=116);
  114. }
  115.  
  116. #include "ctype.h"
  117.  
  118. rd_F(p, w, d, len)
  119. ftnlen len;
  120. ufloat *p;
  121. {
  122.     char s[FMAX+EXPMAXDIGS+4];
  123.     register int ch;
  124.     register char *sp, *spe, *sp1;
  125.     double atof(), x;
  126.     int scale1, se;
  127.     long e, exp;
  128.  
  129.     sp1 = sp = s;
  130.     spe = sp + FMAX;
  131.     exp = -d;
  132.     x = 0.;
  133.  
  134.     do {
  135.         GET(ch);
  136.         w--;
  137.         } while (ch == ' ' && w);
  138.     switch(ch) {
  139.         case '-': *sp++ = ch; sp1++; spe++;
  140.         case '+':
  141.             if (!w) goto zero;
  142.             --w;
  143.             GET(ch);
  144.         }
  145.     while(ch == ' ') {
  146. blankdrop:
  147.         if (!w--) goto zero; GET(ch); }
  148.     while(ch == '0')
  149.         { if (!w--) goto zero; GET(ch); }
  150.     if (ch == ' ' && cblank)
  151.         goto blankdrop;
  152.     scale1 = scale;
  153.     while(isdigit(ch)) {
  154. digloop1:
  155.         if (sp < spe) *sp++ = ch;
  156.         else ++exp;
  157. digloop1e:
  158.         if (!w--) goto done;
  159.         GET(ch);
  160.         }
  161.     if (ch == ' ') {
  162.         if (cblank)
  163.             { ch = '0'; goto digloop1; }
  164.         goto digloop1e;
  165.         }
  166.     if (ch == '.') {
  167.         exp += d;
  168.         if (!w--) goto done;
  169.         GET(ch);
  170.         if (sp == sp1) { /* no digits yet */
  171.             while(ch == '0') {
  172. skip01:
  173.                 --exp;
  174. skip0:
  175.                 if (!w--) goto done;
  176.                 GET(ch);
  177.                 }
  178.             if (ch == ' ') {
  179.                 if (cblank) goto skip01;
  180.                 goto skip0;
  181.                 }
  182.             }
  183.         while(isdigit(ch)) {
  184. digloop2:
  185.             if (sp < spe)
  186.                 { *sp++ = ch; --exp; }
  187. digloop2e:
  188.             if (!w--) goto done;
  189.             GET(ch);
  190.             }
  191.         if (ch == ' ') {
  192.             if (cblank)
  193.                 { ch = '0'; goto digloop2; }
  194.             goto digloop2e;
  195.             }
  196.         }
  197.     switch(ch) {
  198.       default:
  199.         break;
  200.       case '-': se = 1; goto signonly;
  201.       case '+': se = 0; goto signonly;
  202.       case 'e':
  203.       case 'E':
  204.       case 'd':
  205.       case 'D':
  206.         if (!w--)
  207.             goto bad;
  208.         GET(ch);
  209.         while(ch == ' ') {
  210.             if (!w--)
  211.                 goto bad;
  212.             GET(ch);
  213.             }
  214.         se = 0;
  215.           switch(ch) {
  216.           case '-': se = 1;
  217.           case '+':
  218. signonly:
  219.             if (!w--)
  220.                 goto bad;
  221.             GET(ch);
  222.             }
  223.         while(ch == ' ') {
  224.             if (!w--)
  225.                 goto bad;
  226.             GET(ch);
  227.             }
  228.         if (!isdigit(ch))
  229.             goto bad;
  230.  
  231.         e = ch - '0';
  232.         for(;;) {
  233.             if (!w--)
  234.                 { ch = '\n'; break; }
  235.             GET(ch);
  236.             if (!isdigit(ch)) {
  237.                 if (ch == ' ') {
  238.                     if (cblank)
  239.                         ch = '0';
  240.                     else continue;
  241.                     }
  242.                 else
  243.                     break;
  244.                 }
  245.             e = 10*e + ch - '0';
  246.             if (e > EXPMAX && sp > sp1)
  247.                 goto bad;
  248.             }
  249.         if (se)
  250.             exp -= e;
  251.         else
  252.             exp += e;
  253.         scale1 = 0;
  254.         }
  255.     switch(ch) {
  256.       case '\n':
  257.       case ',':
  258.         break;
  259.       default:
  260. bad:
  261.         return (errno = 115);
  262.         }
  263. done:
  264.     if (sp > sp1) {
  265.         while(*--sp == '0')
  266.             ++exp;
  267.         if (exp -= scale1)
  268.             sprintf(sp+1, "e%ld", exp);
  269.         else
  270.             sp[1] = 0;
  271.         x = atof(s);
  272.         }
  273. zero:
  274.     if (len == sizeof(real))
  275.         p->pf = x;
  276.     else
  277.         p->pd = x;
  278.     return(0);
  279.     }
  280.  
  281.  
  282. rd_A(p,len) char *p; ftnlen len;
  283. {    int i,ch;
  284.     for(i=0;i<len;i++)
  285.     {    GET(ch);
  286.         *p++=VAL(ch);
  287.     }
  288.     return(0);
  289. }
  290. rd_AW(p,w,len) char *p; ftnlen len;
  291. {    int i,ch;
  292.     if(w>=len)
  293.     {    for(i=0;i<w-len;i++)
  294.             GET(ch);
  295.         for(i=0;i<len;i++)
  296.         {    GET(ch);
  297.             *p++=VAL(ch);
  298.         }
  299.         return(0);
  300.     }
  301.     for(i=0;i<w;i++)
  302.     {    GET(ch);
  303.         *p++=VAL(ch);
  304.     }
  305.     for(i=0;i<len-w;i++) *p++=' ';
  306.     return(0);
  307. }
  308. rd_H(n,s) char *s;
  309. {    int i,ch;
  310.     for(i=0;i<n;i++)
  311.         if((ch=(*getn)())<0) return(ch);
  312.         else *s++ = ch=='\n'?' ':ch;
  313.     return(1);
  314. }
  315. rd_POS(s) char *s;
  316. {    char quote;
  317.     int ch;
  318.     quote= *s++;
  319.     for(;*s;s++)
  320.         if(*s==quote && *(s+1)!=quote) break;
  321.         else if((ch=(*getn)())<0) return(ch);
  322.         else *s = ch=='\n'?' ':ch;
  323.     return(1);
  324. }
  325.